home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / fish / 726-750 / 745 / bbbbs / bbbbs55.lzh / rexx / ArcBrowse.rexx < prev    next >
OS/2 REXX Batch file  |  1992-08-08  |  5KB  |  200 lines

  1. /*      $VER: 5.5 ArcBrowse.rexx 8 Aug 1992 (8.8.92)
  2.   archives user defined browselist into file in users email
  3. it receives its arguments from rexxDoors/Make_BrowseList.rexx
  4.  copyright 1991-92 Richard Lee Stockton FREELY DISTRIBUTABLE
  5. */
  6.  
  7. SIGNAL ON ERROR
  8. SIGNAL ON SYNTAX
  9. OPTIONS FAILAT 999999
  10.  
  11. PARSE ARG name lastbrowse alphaflag libflag liblist 
  12. lastbrowse=STRIP(lastbrowse)
  13.  
  14. IF ~DATATYPE(lastbrowse,'N') | name='' | alphaflag='' | libflag='' | liblist='' THEN
  15.   CALL GETOUT(20)
  16.  
  17. figarg='s:CONFIG.BBS'
  18. IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
  19. x=OPEN(f,figarg,'R')
  20. IF x=0 THEN
  21.   DO
  22.     SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
  23.     CALL GETOUT(21)
  24.   END
  25. lynes.=''
  26. DO i=1 TO 33
  27.   lynes.i=READLN(f)
  28. END
  29. CALL CLOSE(f)
  30.  
  31. compos=POS('/*',lynes.1)
  32. IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  33. bbsname = STRIP(lynes.1)
  34.  
  35. sysop   = WORD(lynes.2,1)
  36.  
  37. bbspath = WORD(lynes.6,1)
  38. IF ~EXISTS(bbspath) THEN
  39.   DO
  40.     SAY bbspath 'does not exist!'
  41.     CALL SETCLIP('BBS_STAT')
  42.     CALL GETOUT(22)
  43.   END
  44. testchar=RIGHT(bbspath,1)
  45. IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
  46.  
  47. CALL PRAGMA('P',-4)         /* lower the priority of this task */
  48.  
  49. extension=WORD(lynes.32,1)
  50. arccom=lynes.33
  51. compos=POS('/*',lynes.33)
  52. IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
  53. arccom=STRIP(lynes.33)
  54. IF LEFT(extension,1)~='.' THEN
  55.   DO
  56.     extension='.lzh'
  57.     arccom='lharc -m m'
  58.   END
  59.  
  60. filepath=bbspath'EmailFiles/'name
  61. CALL MAKEDIR(filepath)
  62. x=OPEN(f,bbspath'Numbers/LastMail','R')
  63. IF x~=0 THEN lastm=READLN(f)+1
  64. CALL CLOSE(f)
  65. ADDRESS COMMAND 'ECHO >'bbspath'Numbers/LastMail 'lastm
  66. browsename=filepath'/BBBBS_'lastm
  67.  
  68. filelistname=bbspath'Lists/Files'
  69. filelist.=''
  70. x=OPEN(f,filelistname,'R')
  71. IF x=0 THEN CALL GETOUT(23)
  72. DO i=1
  73.   line=READLN(f)
  74.   IF EOF(f) THEN LEAVE i
  75.   indx=WORD(line,1)
  76.   IF DATATYPE(indx,'N') THEN filelist.indx=line
  77. END
  78. filelist.0=indx
  79. CALL CLOSE(f)
  80. numba=filelist.0
  81.  
  82. IF alphaflag='A' THEN
  83.   DO
  84.     filelistname=filelistname'.ALPHA'
  85.     alphalist.=''
  86.     x=OPEN(f,filelistname,'R')
  87.     IF x=0 THEN CALL GETOUT(24)
  88.     DO i=1
  89.       line=READLN(f)
  90.       IF EOF(f) THEN LEAVE i
  91.       alphalist.i=line
  92.     END
  93.     alphalist.0=i-1
  94.     CALL CLOSE(f)
  95.     numba=alphalist.0
  96.   END
  97.  
  98. x=OPEN(a,browsename,'W')
  99. IF x=0 THEN CALL GETOUT(25)
  100. IF alphaflag='A' THEN temp='alphabetical'
  101. ELSE temp='aged'
  102. title='=' bbsname temp 'file descriptions'
  103. IF libflag='L' THEN title=title 'by library'
  104. CALL WRITELN(a,title)
  105. CALL WRITELN(a,'= Custom archived for' name'  'DATE() TIME('C'))
  106. CALL WRITELN(a,'')
  107. CALL CLOSE(a)
  108.  
  109. IF libflag='A' THEN CALL noteloop(1)
  110. ELSE IF libflag='L' THEN
  111.   DO j=1 TO WORDS(liblist)
  112.     test1=WORD(liblist,j)
  113.     CALL noteloop(0)
  114.   END
  115.  
  116. IF WORD(STATEF(browsename),2)<80 THEN CALL GETOUT(26)
  117. CALL PRAGMA('P',0)         /* normal priority */
  118. ADDRESS COMMAND arccom browsename||extension browsename
  119. IF ~EXISTS(browsename||extension) THEN CALL GETOUT(27)
  120. x=OPEN(f,bbspath'Email/'name'/BBBBS.'lastm,'W')
  121. IF x=0 THEN CALL GETOUT(28)
  122. CALL WRITELN(f,' Mail: 'lastm'   FILE: BBBBS_'lastm||extension)
  123. CALL WRITELN(f,' From: BBBBS')
  124. CALL WRITELN(f,'   To: 'name)
  125. CALL WRITELN(f,' Subj: BrowseList')
  126. CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
  127. CALL WRITELN(f,LEFT('=',75,'='))
  128. CALL WRITELN(f,'Here is the archived list of file descriptions you requested.')
  129. CALL CLOSE(f)
  130. IF GETCLIP('BBS_level')~='' & WORD(GETCLIP('BBS_lastcaller'),1)=name THEN
  131.   DO
  132.     oldmess=GETCLIP('BBS_MESSAGE')
  133.     IF oldmess~='' THEN oldmess=oldmess||'0D0A'x
  134.     CALL SETCLIP('BBS_MESSAGE',oldmess||'Your archived filelist is waiting in Email.')
  135.   END
  136. CALL GETOUT(0)
  137. EXIT
  138.  
  139.  
  140. noteloop:
  141. ARG nflag .
  142. IF alphaflag='A' THEN
  143.   DO i=1 TO numba
  144.     k=i
  145.     k=STRIP(WORD(alphalist.i,3))
  146.     IF filelist.k='' | lastbrowse>=k THEN ITERATE i
  147.     lname=WORD(filelist.k,2)
  148.     fname=WORD(filelist.k,3)
  149.     IF nflag THEN
  150.       DO
  151.         IF FIND(UPPER(liblist),UPPER(lname))=0 THEN ITERATE i
  152.       END
  153.     ELSE IF UPPER(test1)~=UPPER(lname) THEN ITERATE i
  154.     CALL add_note(bbspath'FileNotes/'lname'/'fname)
  155.   END
  156. ELSE
  157.   DO i=numba TO 1 BY -1
  158.     IF filelist.i='' | lastbrowse>=i THEN ITERATE i
  159.     lname=WORD(filelist.i,2)
  160.     fname=WORD(filelist.i,3)
  161.     IF nflag THEN
  162.       DO
  163.         IF FIND(UPPER(liblist),UPPER(lname))=0 THEN ITERATE i
  164.       END
  165.     ELSE IF UPPER(test1)~=UPPER(lname) THEN ITERATE i
  166.     CALL add_note(bbspath'FileNotes/'lname'/'fname)
  167.   END
  168. RETURN
  169.  
  170.  
  171. add_note:
  172. ARG addname
  173. x=OPEN(a,browsename,'A')
  174. IF x=0 THEN CALL GETOUT(30)
  175. CALL WRITELN(a,'=====')
  176. x=OPEN(b,addname,'R')
  177. IF x=0 THEN CALL WRITELN(a,addname 'failed to open for reading!')
  178. ELSE
  179.   DO
  180.     data=READCH(b,65000)
  181.     CALL CLOSE(b)
  182.     CALL WRITECH(a,data)
  183.   END
  184. CALL WRITELN(a,'')
  185. CALL CLOSE(a)
  186. RETURN
  187.  
  188.  
  189. ERROR:
  190. SYNTAX:
  191.  
  192. GETOUT:
  193. ARG errorout
  194. CALL SETCLIP('BBS_BROWSE')
  195. IF errorout>0 THEN SAY 'ArcBrowse error' errorout'!'
  196. EXIT(errorout)
  197.  
  198.  
  199. /* end of ArcBrowse.rexx */
  200.